Work in Progress
This article is currently a work in progress. Feel free to observe while it gets filled out!
Data were gathered for the years 2002-2022, accessed on 21 Dec 2023 through 21 Jan 2023, in Excel spreadsheets available from the American Institute of Physics (AIP); via their Roster of Physics Departments with Enrollment and Degree Data. Due to the structure of the data reporting, enrollment data are considered aggregated for the traditional academic year (beginning in the Fall of the previous year and ending in the Spring of the listed year); in addition to an aggregate of all degree recipients, awarded or extant, for the calendar extent (Jan -> Dec) of the listed year.
For example, in the 2015 report, data regarding enrollments are the
finalized numbers of the 2014-2015 academic year; plus all conferred
Bachelors (BS), MS, and PhD
certificates from January through December (inclusive) of the 2015
calendar year.
Datasheets were edited at an intermediary step to unify and
homogenize data condensation into a tidy data set.
Prior to 2017, the
The Highest Physics Degree Offered field and some associated
enrollment data was not available in the survey. In our analysis, data
were infilled on the condition that if a MS or
PhD degree certificate was conferred during those years,
then the corresponding program at the appropriate level must have
existed; and if a higher level was available in 2017, then it must have
been available in 2015 or 2016.Notes annotations
field was removed from this analysis, as the field appeared consistent
across years, and after 2019 split into a separate datasheet of the same
annual report- the Notes values and changelog are available
at the source data.
Institution-level data were adjusted for varying
spellings and canonizations over time (e.g. Appl Phy ->
Appl Phys, Coll of -, etc.). For the purposes
of this analysis, Institutions that changed from a College,
University, or system designation are simply renamed to their name as of
2022, with information lost regarding that the change occurred. For a
complete listing of the modifications made to Institution
names, consult Lines in the process used to incorporate this data.
The data pipeline is encoded in a function,
169-231 and
269-317process_data(...), demonstrated in the following R
script:
#---- Imports ----#
#
# TODO :> these docs
#
#--------------------------------#
library(tidyverse)
library(readxl)
library(forcats)
#---- process_data(...) ----#
#
# TODO :> these docs
#
#--------------------------------#
process_data <- \(DATA_DIR) {
##########
##-----##
##----##
##---## Read Data
##----##
##-----##
##########
data <- map(
list.files(DATA_DIR, pattern="*.xlsx", full.names=T),
\(.file) {
#####
## Excel Parse
#####
readxl::read_excel(
.file,
sheet = 'data',
col_types = c(
'text', # Institution
'text', # State; 2-chr factor-level
'text', # Highest Degree Offered; 3-level factor of `BS`, `MS`, or `PhD`
'text', # Astro Program; 3-level factor of `combined`, `separate`, or `none`
'text', # Notes
'numeric', # First-Term Introductory Physics Course Enrollments
'numeric', # First-Term Introductory Physical Science and Astronomy Course Enrollments
'numeric', # Fall Junior Enrollments
'numeric', # Fall Senior Enrollments
'numeric', # Fall Total Graduate Student Enrollments
'numeric', # Fall Non-US Graduate Student Enrollments
'numeric', # Fall First-Year Graduate Student Enrollments
'numeric', # Physics Bachelors
'numeric', # Exiting Physics Masters
'numeric' # Physics PhDs
),
na = c('---', ''),
.name_repair = \(cols) { # unify column names
cols |>
gsub('(Fall [1-2]{1}([0-1]|[8-9]){1}([0-9]){1}[0-9]{1})', 'Fall', x = _, perl=TRUE) |>
gsub('(^(20[0-9]{2}\\-[0-9]{2})\\s+)|(\\-)', '', x = _, perl=TRUE) |>
gsub('\\s*(\\w+)\\s+', '\\1_', x = _, perl=TRUE)
#gsub('(First-Term)', 'FirstTerm', x = _, perl=TRUE)
}
) |>
#####
## Denote Year
#####
mutate(
Year = parse_number(
paste0(
'20',
gsub(
paste0(DATA_DIR, "*physrostr{0,1}([0-9]{2}).xlsx$"),
"\\1",
.file))),
.before = Institution
)
}) |>
##########
##-----##
##----##
##---## Process Data
##----##
##-----##
##########
map( \(.tbl) {
#####
## transform `*_Enrollments` fields, added in (TODO:> ???)
#####
if ('Fall_Total_Graduate_Student_Enrollments' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Fall_Total_Graduate_Student_Enrollments = NA, .name_repair = 'unique') }
if ('Fall_FirstYear_Graduate_Student_Enrollments' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Fall_FirstYear_Graduate_Student_Enrollments = NA, .name_repair = 'unique') }
if ('Fall_Senior_Enrollments' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Fall_Senior_Enrollments = NA, .name_repair = 'unique') }
if ('Fall_Junior_Enrollments' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Fall_Junior_Enrollments = NA, .name_repair = 'unique') }
if ('Fall_NonUS_Graduate_Student_Enrollments' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Fall_NonUS_Graduate_Student_Enrollments = NA, .name_repair = 'unique') }
if ('Highest_Physics_Degree_Offered' %in% names(.tbl) == F)
{ .tbl <- .tbl |> add_column(Highest_Physics_Degree_Offered = NA, .name_repair = 'unique') }
.tbl |>
#####
## drop unused columns
#####
select(-any_of(c('Notes', 'Highest_Degree_Offered'))) |>
#####
## transform `Highest Physics Degree Offered`, added in 2017
#####
mutate(
Highest_Physics_Degree_Offered = if_else(
is.na(Highest_Physics_Degree_Offered),
if_else(
is.na(Physics_PhDs),
if_else(
is.na(Fall_Total_Graduate_Student_Enrollments),
'BS',
'MS'
),
'PhD'
),
Highest_Physics_Degree_Offered
)) |>
mutate( Highest_Physics_Degree_Offered = as.factor(Highest_Physics_Degree_Offered) ) |>
mutate(
`Highest_Physics_Degree_Offered` = fct_relevel( `Highest_Physics_Degree_Offered`, c('BS','MS','PhD'))
) |>
#####
## transform/convert `Astro Program` into factor
#####
mutate(
Astro_Program = case_when(
Astro_Program == 'c' ~ 'combined',
Astro_Program == 's' ~ 'separate'
)
) |>
mutate(
Astro_Program = as.factor(Astro_Program)
) |>
mutate(
`Astro_Program` = fct_relevel( `Astro_Program`, c('no dept.', 'separate', 'combined'))
) |>
#####
## transform State, Year into factors
#####
mutate(State = as.factor(State)) |>
mutate(Year = as.factor(Year)) |>
#####
## transform `Appl Phy` -> `Appl Phys`
#####
mutate(
Institution = gsub("(\\(Appl Phy\\))", "\\(Appl Phys\\)", Institution)
) |>
#####
## transform Institution name `College` -> `Coll`, drop apostrophe
#####
mutate(
Institution = gsub(
"((College(s){0,1})(\\s+(of)){0,1}\\s*\\w{0})$", "Coll \\4",
Institution,
perl = TRUE
)
) |>
mutate(
Institution = Institution |>
gsub("'", '', x = _) |>
gsub("*", '', x = _) |>
trimws(which = "both") |>
str_squish()
) |>
#####
## transform Institution names for continuity
#####
mutate(
Institution = Institution |>
gsub("(Coll\\.)", "Coll", x=_) |>
gsub("(\\*)", "", x=_) |>
gsub("(Maryland-U of, Coll Park)", "Maryland-U of, College Park", x=_) |>
gsub("(Minnesota-U of, Minnpls)", "Minnesota-U of, Minnpls/TwinCities", x=_) |>
gsub("(Minnesota-U of, Twin Cities)", "Minnesota-U of, Minnpls/TwinCities", x=_) |>
gsub("(Mary Baldwin Coll)", "Mary Baldwin U", x=_) |>
gsub("(Piedmont Coll)", "Piedmont U", x=_) |>
gsub("(William & Mary-Coll of)", "William & Mary", x=_) |>
gsub("(SUNY Coll at Brockport)", "SUNY Brockport", x=_) |>
gsub("(Notre Dame of MD-Coll of)", "Notre Dame of MD U", x=_) |>
gsub("(Fresno State U)", "Cal St U-Fresno", x=_) |>
gsub("(Muskingum Coll)", "Muskingum U", x=_) |>
gsub("(Central Methodist Coll)", "Central Methodist U", x=_) |>
gsub("(Indiana U Purdue U-Ft Wayne)", "Purdue U-Ft Wayne", x=_) |>
gsub("(Purdue U-Calumet)", "Purdue U-Northwest", x=_) |>
gsub("(Armstrong Atlantic St U)", "Armstrong State U", x=_) |>
gsub("(Armstrong State U)", "Georgia Southern U", x=_) |>
gsub("(Lynchburg Coll)", "Lynchburg-U of", x=_) |>
gsub("(St. John Fisher Coll)", "St. John Fisher U", x=_) |>
gsub("(Greenville Coll)", "Greenville U", x=_) |>
gsub("(Bloomsburg U of PA)", "Commonwealth U of PA", x=_) |>
gsub("(Roberts Wesleyan Coll)", "Roberts Wesleyan U", x = _) |>
gsub("(Doane Coll)", "Doane U", x = _) |>
gsub("(Simmons Coll)", "Simmons U", x = _) |>
gsub("(Thomas More Coll)", "Thomas More U", x = _) |>
gsub("(Linfield Coll)", "Linfield U", x = _) |>
gsub("(Dordt Coll)", "Dordt U", x = _) |>
gsub("(Otterbein Coll)", "Otterbein U", x = _) |>
gsub("(Messiah Coll)", "Messiah U", x = _) |>
gsub("(Sacramento State U)", "Cal St U-Sacramento", x = _) |>
gsub("(Pennsylvania St U-Erie)", "Pennsylvania St Behrend", x = _) |>
gsub("(New York U, Polytechnic Sch. of Eng.)", "New York U, Tandon Sch. of Engrg.", x = _) |>
gsub("(Calvin Coll)", "Calvin U", x = _) |>
gsub("(Augusta State U)", "Augusta U", x = _) |>
gsub("(Elmhurst Coll)", "Elmhurst U", x = _) |>
gsub("(Moravian Coll)", "Moravian U", x = _) |>
gsub("(Augsburg Coll)", "Augsburg U", x = _) |>
gsub("(Centre Coll of KY)", "Centre Coll", x = _) |>
gsub("(Humboldt State U)", "Cal St Poly U-Humboldt", x = _) |>
gsub("(Texas State U-San Marcos)", "Texas State U", x = _) |>
gsub("(Richard Stockton Coll of NJ)", "Stockton U", x = _) |>
gsub("(Chatham Coll)", "Chatham U", x = _) |>
gsub("(The Sciences of Philadelphia-U of)", "The Sciences-U of", x = _) |>
gsub("(Baldwin-Wallace Coll)", "Baldwin-Wallace U", x = _) |>
gsub("(St\\. Catherine-Coll of)", "St. Catherine U", x = _) |>
gsub("(Walla Walla Coll)", "Walla Walla U", x = _) |>
gsub("(New York U \\(NYU\\))", "New York U, School of Arts & Science", x = _) |>
gsub("(Engrg\\.g\\.)", "Engrg.", x = _) |>
gsub("(Whitworth Coll)", "Whitworth U", x = _) |>
gsub("(King Coll)", "King U", x = _) |>
gsub("(NJIT/Rutgers U-Newark)", "New Jersey Inst of Tech", x = _) |>
gsub("(Rutgers U-Newark/NJIT)", "Rutgers U-Newark", x = _) |>
gsub("(St\\. Peters Coll)", "St. Peters U", x = _) |>
gsub("(MO-U of, Rolla)", "Missouri U of Sci & Tech", x = _) |>
gsub("(Metropolitan St Coll of Denver)", "Metropolitan St U of Denver", x = _) |>
gsub("(Mesa State Coll)", "Colorado Mesa U", x = _) |>
gsub("(Southern Polytechnic St U)", "Kennesaw State U", x = _) |>
gsub("(Bridgewater State Coll)", "Bridgewater State U", x = _) |>
gsub("(W\\. Virginia Wesleyan Coll)", "West Virginia Wesleyan Coll", x = _) |>
gsub("(Cal Poly St U-San L\\.O\\.)", "Cal Poly St U-San Luis Obispo", x = _) |>
gsub("(Elon Coll)", "Elon U", x = _) |>
gsub("(Manchester Coll)", "Manchester U", x = _) |>
gsub("(Utah Valley State Coll)", "Utah Valley U", x = _) |>
gsub("(Mount Union Coll)", "Mount Union-U of", x = _) |>
gsub("(Albertson Coll of Idaho)", "Coll of Idaho", x = _) |>
gsub("(Cal St U-Hayward)", "Cal St U-East Bay", x = _) |>
gsub("(Point Loma Nazarene Coll)", "Point Loma Nazarene U", x = _) |>
gsub("(Colorado St U, Fort Collins)", "Colorado St U-Fort Collins", x = _) |>
gsub("(Colorado State U)", "Colorado St U-Fort Collins", x = _) |>
gsub("(Yale U \\(Appl Sci\\))", "Yale U (Appl Phys)", x = _) |>
gsub("(West Georgia-State U of)", "West Georgia-U of", x = _) |>
gsub("(North Georgia Coll & St U)", "North Georgia-U of", x = _) |>
gsub("(Notre Dame-Coll of, MD)", "Notre Dame of MD U", x = _) |>
gsub("(Cumberland Coll)", "Cumberlands-U of the", x = _) |>
gsub("(Missouri Southern St Coll)", "Missouri Southern St U", x = _) |>
gsub("(Missouri St U)", "Missouri State U", x = _) |>
gsub("(Central Missouri State U)", "Central Missouri-U of", x = _) |>
gsub("(Southwest Missouri State U)", "Missouri State U", x = _) |>
gsub("(Georgian Court Coll)", "Georgian Court U", x = _) |>
gsub("(OK-U of Sci and Arts)", "Sci and Arts of OK-U of", x = _) |>
gsub("(Southwest Texas St U)", "Texas State U", x = _) |>
gsub("(Houston-U of-Downtown)", "Houston-U of, Downtown", x = _) |>
gsub("(Mary Washington Coll)", "Mary Washington-U of", x = _) |>
gsub("(Virginia Tech)", "Virginia Polytech Inst & St U", x = _) |>
gsub("(Randolph-Macon Womans Coll)", "Randolph Coll", x = _)
) |>
mutate(
Institution = case_when(
Institution == "Augustana Coll" & State == "SD" ~ "Augustana U",
Institution == "Xavier U" & State == "LA" ~ "Xavier U of Louisiana",
Institution == "Union Coll" & State == "NY" ~ "Union Coll (NY)",
Institution == "Union Coll" & State == "NE" ~ "Union Coll (NE)",
Institution == "Westminster Coll" & State == "PA" ~ "Westminster Coll (PA)",
Institution == "Westminster Coll" & State == "UT" ~ "Westminster Coll (UT)",
Institution == "Westminster Coll" & State == "MO" ~ "Westminster Coll (MO)",
Institution == "St. Thomas-U of" & State == "MN" ~ "St. Thomas-U of (MN)",
Institution == "St. Thomas-U of" & State == "TX" ~ "St. Thomas-U of (TX)",
Institution == "Wheaton Coll" & State == "IL" ~ "Wheaton Coll (IL)",
Institution == "Wheaton Coll" & State == "MA" ~ "Wheaton Coll (MA)",
Institution == "Embry-Riddle Aeronautical U" & State == "FL" ~ "Embry-Riddle Aeronautical U (FL)",
Institution == "Embry-Riddle Aeronautical U" & State == "AZ" ~ "Embry-Riddle Aeronautical U (AZ)",
Institution == "Georgetown U" & State == "KY" ~ "Georgetown Coll",
Institution == "Lincoln U" & State == "MO" ~ "Lincoln U (MO)",
Institution == "Lincoln U" & State == "PA" ~ "Lincoln U (PA)",
Institution == "Bethel Coll" & State == "MN" ~ "Bethel U",
Institution == "St. Johns U" & State == "MN" ~ "Coll of St. Benedict / St. Johns U",
Institution == "Loyola Coll" & State == "MD" ~ "Loyola U of MD",
.default = Institution
)
) |>
## remove `TN-U of, Space Inst`, dupl by `TN-U of, Knoxville`, the host Inst.
#filter(!(Institution == "TN-U of, Space Inst")) |>
#####
## set column order
#####
relocate(
`Year`,
`Institution`,
`State`,
`Highest_Physics_Degree_Offered`,
`Fall_Total_Graduate_Student_Enrollments`,
`Physics_PhDs`,
`Exiting_Physics_Masters`,
`Fall_FirstYear_Graduate_Student_Enrollments`,
`Physics_Bachelors`,
`Fall_Senior_Enrollments`,
`Fall_Junior_Enrollments`,
`FirstTerm_Introductory_Physics_Course_Enrollments`,
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments`,
`Fall_NonUS_Graduate_Student_Enrollments`,
`Astro_Program`
) |>
select(
`Year`,
`Institution`,
`State`,
`Highest_Physics_Degree_Offered`,
`Fall_Total_Graduate_Student_Enrollments`,
`Physics_PhDs`,
`Exiting_Physics_Masters`,
`Fall_FirstYear_Graduate_Student_Enrollments`,
`Physics_Bachelors`,
`Fall_Senior_Enrollments`,
`Fall_Junior_Enrollments`,
`FirstTerm_Introductory_Physics_Course_Enrollments`,
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments`,
`Fall_NonUS_Graduate_Student_Enrollments`,
`Astro_Program`
)
}) |>
##########
##-----##
##----##
##---## Save Data
##----##
##-----##
##########
## unify observation collection
list_rbind() |>
## group observations of Institution by Year, then by State
group_by(State, Institution, Year) |>
## sort-asc within previous group by quantity
arrange(Physics_PhDs, .by_group = TRUE)
##########
##-----##
##----##
##---## Targeted Adjustments
##----##
##-----##
##########
## `Georgia Southern U`
gdata <-
data |>
filter(Institution == "Georgia Southern U")
data <- anti_join(data, gdata, by = 'Institution')
gdata <-
gdata |>
ungroup() |>
group_by(Year) |>
summarise(
`Year` = Year,
`Institution` = Institution,
`State` = State,
`Highest_Physics_Degree_Offered` = Highest_Physics_Degree_Offered,
`Fall_Total_Graduate_Student_Enrollments` = sum(Fall_Total_Graduate_Student_Enrollments),
`Physics_PhDs` = sum(Physics_PhDs),
`Exiting_Physics_Masters` = sum(Exiting_Physics_Masters),
`Fall_FirstYear_Graduate_Student_Enrollments` = sum(Fall_FirstYear_Graduate_Student_Enrollments),
`Physics_Bachelors` = sum(Physics_Bachelors),
`Fall_Senior_Enrollments` = sum(Fall_Senior_Enrollments),
`Fall_Junior_Enrollments` = sum(Fall_Junior_Enrollments),
`FirstTerm_Introductory_Physics_Course_Enrollments` = sum(FirstTerm_Introductory_Physics_Course_Enrollments),
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments` = sum(FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments),
`Fall_NonUS_Graduate_Student_Enrollments` = sum(Fall_NonUS_Graduate_Student_Enrollments),
`Astro_Program` = Astro_Program
) |>
distinct()
data <- data |> ungroup()
data <- full_join(data, gdata)
## `UT-Brownsville` + `UT-PanAm` -> `UT-RioGrandeValley`
gdata <-
data |>
filter(Institution %in% c(
"Texas-U of, at Brownsville",
"Texas-U of, Pan American",
"Texas-U of, Rio Grande Valley"
))
data <- anti_join(data, gdata, by = 'Institution')
gdata <-
gdata |>
ungroup() |>
mutate(
Institution = "Texas-U of, Rio Grande Valley",
`Highest_Physics_Degree_Offered` = case_when(
`Highest_Physics_Degree_Offered` == 'BS' ~ 'MS',
.default = `Highest_Physics_Degree_Offered`
)
) |>
group_by(Year) |>
summarise(
`Year` = Year,
`Institution` = Institution,
`State` = State,
`Highest_Physics_Degree_Offered` = Highest_Physics_Degree_Offered,
`Fall_Total_Graduate_Student_Enrollments` = sum(Fall_Total_Graduate_Student_Enrollments),
`Physics_PhDs` = sum(Physics_PhDs),
`Exiting_Physics_Masters` = sum(Exiting_Physics_Masters),
`Fall_FirstYear_Graduate_Student_Enrollments` = sum(Fall_FirstYear_Graduate_Student_Enrollments),
`Physics_Bachelors` = sum(Physics_Bachelors),
`Fall_Senior_Enrollments` = sum(Fall_Senior_Enrollments),
`Fall_Junior_Enrollments` = sum(Fall_Junior_Enrollments),
`FirstTerm_Introductory_Physics_Course_Enrollments` = sum(FirstTerm_Introductory_Physics_Course_Enrollments),
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments` = sum(FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments),
`Fall_NonUS_Graduate_Student_Enrollments` = sum(Fall_NonUS_Graduate_Student_Enrollments),
`Astro_Program` = Astro_Program
) |>
distinct()
data <- data |> ungroup()
data <- full_join(data, gdata)
## `Mansfield U` + `Lock Haven U` + `Bloomsburg U` -> `Commonwealth U of PA`
gdata <-
data |>
filter(Institution %in% c(
"Mansfield U",
"Lock Haven U",
"Bloomsburg U",
"Commonwealth U of PA"
))
data <- anti_join(data, gdata, by = 'Institution')
gdata <-
gdata |>
ungroup() |>
mutate(
Institution = "Commonwealth U of PA",
) |>
group_by(Year) |>
summarise(
`Year` = Year,
`Institution` = Institution,
`State` = State,
`Highest_Physics_Degree_Offered` = Highest_Physics_Degree_Offered,
`Fall_Total_Graduate_Student_Enrollments` = sum(Fall_Total_Graduate_Student_Enrollments),
`Physics_PhDs` = sum(Physics_PhDs),
`Exiting_Physics_Masters` = sum(Exiting_Physics_Masters),
`Fall_FirstYear_Graduate_Student_Enrollments` = sum(Fall_FirstYear_Graduate_Student_Enrollments),
`Physics_Bachelors` = sum(Physics_Bachelors),
`Fall_Senior_Enrollments` = sum(Fall_Senior_Enrollments),
`Fall_Junior_Enrollments` = sum(Fall_Junior_Enrollments),
`FirstTerm_Introductory_Physics_Course_Enrollments` = sum(FirstTerm_Introductory_Physics_Course_Enrollments),
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments` = sum(FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments),
`Fall_NonUS_Graduate_Student_Enrollments` = sum(Fall_NonUS_Graduate_Student_Enrollments),
`Astro_Program` = Astro_Program
) |>
distinct()
data <- data |> ungroup()
data <- full_join(data, gdata)
## Group and Sort
data <- data |>
mutate(idx = row_number()) |>
## group observations of Institution by Year, then by State
group_by(State, Institution, Year) |>
## sort-asc within previous group by quantity
arrange(Physics_PhDs, .by_group = TRUE)
##########
##-----##
##----##
##---## Return
##----##
##-----##
##########
data
}Columns have summary metrics generated for groupings of observations,
given an Institution over a set of Years.
These have been marked as Accumulative or
Averaged. Data at the individual observation level
(foreach Institution, foreach Year)
have been altered from their original values -
incl. Georgia Southern U, 2, 3, TODO which
combined with another institution in 2018.
library(tidyverse)
library(reactable)
library(ggplot2)
library(ggsci)
library(ggformula)
library(wesanderson)
library(plotly)
library(htmltools)
library(crosstalk)
DATA_DIR = './data/xlsx_edit/'
source('./process_data.R', local = knitr::knit_global())
##########
##-----##
##----##
##---## Data Table
##----##
##-----##
##########
rosterdata <- process_data(DATA_DIR);
####
## Build sharedData instances with enumerated `row.names` (keys); filter and dispatch auto-linked
## SharedData s.t. selections can be made across table and graphs while allowing interpolated spline linegraphs
tdata <- SharedData$new(
rosterdata,
group = 'linegrph'
);
d = list(
`Physics_PhDs` = SharedData$new(
rosterdata |>
filter(!is.na(Physics_PhDs)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(Physics_PhDs)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Exiting_Physics_Masters` = SharedData$new(
rosterdata |>
filter(!is.na(Exiting_Physics_Masters)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Exiting_Physics_Masters`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Fall_FirstYear_Graduate_Student_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(Fall_FirstYear_Graduate_Student_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Fall_FirstYear_Graduate_Student_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Fall_NonUS_Graduate_Student_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(Fall_NonUS_Graduate_Student_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Fall_NonUS_Graduate_Student_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Fall_Total_Graduate_Student_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(Fall_Total_Graduate_Student_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Fall_Total_Graduate_Student_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Physics_Bachelors` = SharedData$new(
rosterdata |>
filter(!is.na(Physics_Bachelors)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Physics_Bachelors`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Fall_Senior_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(Fall_Senior_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Fall_Senior_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`Fall_Junior_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(Fall_Junior_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`Fall_Junior_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`FirstTerm_Introductory_Physics_Course_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(FirstTerm_Introductory_Physics_Course_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`FirstTerm_Introductory_Physics_Course_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
),
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments` = SharedData$new(
rosterdata |>
filter(!is.na(FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments)) |>
(\(.tbl) {
.holdout <-
.tbl |>
filter(!is.na(`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments`)) |>
group_by(Institution) |>
mutate(count = n()) |>
filter(count < 4) |>
select(Institution) |>
unique() |>
deframe()
.holdout_obs <-
.tbl |>
filter(Institution %in% .holdout)
.rest <- anti_join(.tbl, .holdout_obs)
.rest
})(),
key = ~idx,
group = 'linegrph'
)
)
#####
## Generate Reactable data table
#####
rxtbl <- tdata |>
reactable(
####
## main table
####
elementId = 'rosterphys02_22-tbl',
filterable = T,
searchable = T,
groupBy = c('Institution'),
bordered = T,
#striped = T,
highlight = T,
compact = T,
fullWidth = T,
pagination = F,
showPageSizeOptions = T,
pageSizeOptions = c(6, 12, 18),
paginationType = "jump",
selection = "multiple",
onClick = "select",
height = 768,
rowStyle = JS("
function(rowInfo, state) {
if (!rowInfo) return;
// style nested rows
if (rowInfo.level > 0) {
return { background: '#eee', borderLeft: '2px solid #ffa62d' }
} else {
return { borderLeft: '2px solid transparent' }
}
}
"),
#details = function(idx) {
# d <- rosterdata |> filter(Institution == rosterdata$Institution[idx])
# htmltools::div(style = "padding: 1rem",
# reactable(
# d,
# outlined = TRUE
# )
# )
#},
defaultColDef = colDef(
header = function(value) gsub(".", " ", value, fixed = TRUE),
headerClass = "sticky tbl-header",
cell = function(value) format(value, nsmall = 1),
filterable = F,
align = "center",
minWidth = 120,
headerStyle = list(background = "#f7f7f8"),
vAlign = 'center',
headerVAlign = 'bottom',
format = colFormat(
separators = T,
digits = 0
)
),
defaultSorted = list(
Year = 'asc',
Physics_PhDs = 'desc',
Physics_Bachelors = 'desc'
),
defaultPageSize = 6,
minRows = 4,
####
## Per-Column defns
####
columns = list(
`Year` = colDef(
name = 'Year',
align = "center",
minWidth = 64,
sticky = "left",
sortable = T,
defaultSortOrder = "asc"
),
`Institution` = colDef(
name = 'Institution',
align = 'left',
minWidth = 240,
sticky = "left",
filterable = T
),
`State` = colDef(
name = 'State',
minWidth = 64,
aggregate = 'unique',
filterable = T
),
`Highest_Physics_Degree_Offered` = colDef(
name = "Highest Physics Degree Offered",
aggregate = "unique",
),
`Fall_Total_Graduate_Student_Enrollments` = colDef(
name = "Total Grad Student Enrollment (Fall)\n (Averaged)",
aggregate = "mean",
),
`Physics_PhDs` = colDef(
name = "Physics PhDs\n (Accum)",
aggregate = "sum",
format = colFormat(digits=0)
),
`Exiting_Physics_Masters` = colDef(
name = "Exiting Physics Masters\n (Accum)",
aggregate = "sum",
format = colFormat(digits=0)
),
`Fall_FirstYear_Graduate_Student_Enrollments` = colDef(
name = "First-Year Grad Student Enrollment (Fall)\n (Averaged)",
aggregate = "mean",
),
`Physics_Bachelors` = colDef(
name = "Physics Bachelors\n (Accum)",
aggregate = "sum",
format = colFormat(digits=0)
),
`Fall_Senior_Enrollments` = colDef(
name = "Senior Enrollment (Fall)\n (Averaged)",
aggregate = "mean",
),
`Fall_Junior_Enrollments` = colDef(
name = "Junior Enrollment (Fall)\n (Averaged)",
aggregate = "mean",
),
`FirstTerm_Introductory_Physics_Course_Enrollments` = colDef(
name = "First-Term Intro Physics Course Enrollment\n (Averaged)",
aggregate = "mean",
),
`FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments` = colDef(
name = "First-Term Intro Phys. Sci. and Astro. Course Enrollment\n (Averaged)",
aggregate = "mean",
),
`Fall_NonUS_Graduate_Student_Enrollments` = colDef(
name = "Non-US Grad Student Enrollment (Fall)\n (Averaged)",
aggregate = "mean",
),
`Astro_Program` = colDef(
name = "Astro Program?",
minWidth = 80,
align = "right",
aggregate = JS("
function(values, rows) {
return(values
.filter((v) => v == 'combined' || v == 'separate')
.map((v) => v == 'combined' ? 'c' : 's')
.reduce(function (acc, curr) {
if (!acc.includes(curr))
acc.push(curr);
return acc;
}, [])
.join(', '));
}
")
)
)
)
#####
## Display Shiny with Crosstalk/htmltools widgets
#####
shiny::fluidPage(
shiny::fluidRow(
shiny::column(
2,
htmltools::browsable(
tagList(
tags$div(
class = 'd-grid gap-2 mx-auto',
# CSV download button
tags$button(
tagList(fontawesome::fa("download"), "\tCSV Data"),
class = 'btn btn-outline-success',
onclick = "Reactable.downloadDataCSV('rosterphys02_22-tbl', 'rosterphys02_22.csv')"
),
# Expand/Collapse button
tags$button(
"Expand/Collapse\nRows",
class = 'btn btn-info',
onclick = "Reactable.toggleAllRowsExpanded('rosterphys02_22-tbl')",
),
)
)
),
# filter-by degree
#filter_checkbox("degree", "Degree Level", tdata, ~Highest_Physics_Degree_Offered),
# TODO :> sticky column toggle button
# Group Selection
htmltools::browsable(
tagList(
tags$div(
class = "p-2",
tags$b(
tags$label("Group By", `for` = "rosterphys02_22-grp_select"),
),
tags$ul(
id = "rosterphys02_22-grp_select",
class = "list-group",
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
value = "State",
id = "grp_select-state",
onchange = "Reactable.setGroupBy(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-grp_select li input[type=checkbox]')]
.map((e) => e.checked ? e.value : false)
.filter((w) => w !== false)
)"
),
tags$label(
"State",
class = "form-check-label",
`for` = "grp_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
value = "Highest_Physics_Degree_Offered",
id = "grp_select-program",
onchange = "Reactable.setGroupBy(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-grp_select li input[type=checkbox]')]
.map((e) => e.checked ? e.value : false)
.filter((w) => w !== false)
)"
),
tags$label(
"Program",
class = "form-check-label",
`for` = "grp_select-program",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
value = "Year",
id = "grp_select-year",
onchange = "Reactable.setGroupBy(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-grp_select li input[type=checkbox]')]
.map((e) => e.checked ? e.value : false)
.filter((w) => w !== false)
)"
),
tags$label(
"Year",
class = "form-check-label",
`for` = "grp_select-year",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
value = "Institution",
id = "grp_select-inst",
checked = NA,
onchange = "Reactable.setGroupBy(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-grp_select li input[type=checkbox]')]
.map((e) => e.checked ? e.value : false)
.filter((w) => w !== false)
)"
),
tags$label(
"Institution",
class = "form-check-label",
`for` = "grp_select-inst",
)
),
)
),
# column visibility selection
tags$div(
class = "p-2",
tags$b(
tags$label("Visible Columns", `for` = "rosterphys02_22-vis_select"),
),
tags$ul(
id = "rosterphys02_22-vis_select",
class = "list-group",
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Fall_Total_Graduate_Student_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"Total Grad Stdnts",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Physics_PhDs",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"PhDs",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Exiting_Physics_Masters",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"MS",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Fall_FirstYear_Graduate_Student_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"FirstYear Grad Stdnts",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Physics_Bachelors",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"BS",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Fall_Senior_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"Seniors",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Fall_Junior_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"Juniors",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "FirstTerm_Introductory_Physics_Course_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"Intro Phys",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"PhySci+Astro",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Fall_NonUS_Graduate_Student_Enrollments",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"NonUS Grad Stdnts",
class = "form-check-label",
`for` = "vis_select-state",
)
),
tags$li(
class = "list-group-item",
tags$input(
class = "form-check-input me-1",
type = "checkbox",
checked = NA,
value = "Astro_Program",
id = "vis_select-state",
onchange = "Reactable.setHiddenColumns(
'rosterphys02_22-tbl',
[...document.querySelectorAll('#rosterphys02_22-vis_select li input[type=checkbox]')]
.map((e) => e.checked ? false : e.value)
.filter((w) => w !== false)
)"
),
tags$label(
"Astro Dept",
class = "form-check-label",
`for` = "vis_select-state",
)
),
)
),
)
),
),
shiny::column(
10,
# DataTable
rxtbl,
# TODO :> add line-graph over time here using selected data from table
## Prints all overlaid,
htmltools::browsable(
tagList(
tags$div(
id = 'linegrphs',
tags$nav(
tags$div(
class = "nav nav-tabs",
role = "tablist",
id = "linegrphs-tabs",
# PHDs
tags$button(
class = 'nav-link active',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'true',
`data-bs-target` = '#linegrph_physicsphd-tabcontent',
`aria-controls` = 'linegrph_physicsphd-tabcontent',
id = 'linegraph_physicsphd-tab',
"PhDs"
),
# Masters
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_masters-tabcontent',
`aria-controls` = 'linegrph_masters-tabcontent',
id = 'linegraph_masters-tab',
"Masters"
),
# Total Grad Stdnts
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_totalgrads-tabcontent',
`aria-controls` = 'linegrph_totalgrads-tabcontent',
id = 'linegraph_totalgrads-tab',
"Total Grad Stdnts"
),
# FirstYear Grad Stdnts
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_fygrads-tabcontent',
`aria-controls` = 'linegrph_fygrads-tabcontent',
id = 'linegraph_fygrads-tab',
"FirstYear Grad Stdnts"
),
# NonUS Grad Stdnts
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_nonusgrads-tabcontent',
`aria-controls` = 'linegrph_nonusgrads-tabcontent',
id = 'linegraph_nonusgrads-tab',
"NonUS Grad Stdnts"
),
# Bachelors
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_bachelors-tabcontent',
`aria-controls` = 'linegrph_bachelors-tabcontent',
id = 'linegraph_bachelors-tab',
"Bachelors"
),
# Seniors
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_seniors-tabcontent',
`aria-controls` = 'linegrph_seniors-tabcontent',
id = 'linegraph_seniors-tab',
"Seniors"
),
# Juniors
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_juniors-tabcontent',
`aria-controls` = 'linegrph_juniors-tabcontent',
id = 'linegraph_juniors-tab',
"Juniors"
),
# Intro Phys
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_introphys-tabcontent',
`aria-controls` = 'linegrph_introphys-tabcontent',
id = 'linegraph_introphys-tab',
"Intro Phys"
),
# PhySci+Astro
tags$button(
class = 'nav-link',
`data-bs-toggle` = 'tab',
type = 'button',
role = 'tab',
`aria-selected` = 'false',
`data-bs-target` = '#linegrph_physastro-tabcontent',
`aria-controls` = 'linegrph_physastro-tabcontent',
id = 'linegraph_physastro-tab',
"PhySci+Astro"
),
),
),
tags$div(
class = 'tab-content',
id = 'linegrph_tabscontent',
# PhDs
tags$div(
class = 'tab-pane fade show active',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_physicsphd-tab',
id = 'linegrph_physicsphd-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Physics_PhDs,
aes(
x = Year,
y = Physics_PhDs,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "Conferred Physics PhDs by Institution per Year",
x = "Year",
y = "Physics PhDs"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Masters
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_masters-tab',
id = 'linegrph_masters-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Exiting_Physics_Masters,
aes(
x = Year,
y = `Exiting_Physics_Masters`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "Conferred Exiting Masters by Institution per Year",
x = "Year",
y = "Exiting Masters"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Total Grad Stdnts
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_totalgrads-tab',
id = 'linegrph_totalgrads-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Fall_Total_Graduate_Student_Enrollments,
aes(
x = Year,
y = `Fall_Total_Graduate_Student_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "Total (Fall) Graduate Student Enrollments by Institution per Year",
x = "Year",
y = "Total (Fall) Graduate Student Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# FirstYear Grad Stdnts
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_fygrads-tab',
id = 'linegrph_fygrads-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Fall_FirstYear_Graduate_Student_Enrollments,
aes(
x = Year,
y = `Fall_FirstYear_Graduate_Student_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "(Fall) First-Year Graduate Student Enrollments by Institution per Year",
x = "Year",
y = "(Fall) First-Year Graduate Student Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# NonUS Grad Stdnts
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_nonusgrads-tab',
id = 'linegrph_nonusgrads-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Fall_NonUS_Graduate_Student_Enrollments,
aes(
x = Year,
y = `Fall_NonUS_Graduate_Student_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "(Fall) Non-US Graduate Student Enrollments by Institution per Year",
x = "Year",
y = "(Fall) Non-US Graduate Student Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Bachelors
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_bachelors-tab',
id = 'linegrph_bachelors-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Physics_Bachelors,
aes(
x = Year,
y = `Physics_Bachelors`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "Physics Bachelors Conferred by Institution per Year",
x = "Year",
y = "Physics Bachelors Conferred"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Seniors
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_seniors-tab',
id = 'linegrph_seniors-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Fall_Senior_Enrollments,
aes(
x = Year,
y = `Fall_Senior_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "(Fall) Senior Enrollments by Institution per Year",
x = "Year",
y = "(Fall) Senior Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Juniors
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_juniors-tab',
id = 'linegrph_juniors-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$Fall_Junior_Enrollments,
aes(
x = Year,
y = `Fall_Junior_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "(Fall) Junior Enrollments by Institution per Year",
x = "Year",
y = "(Fall) Junior Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# Intro Phys
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_introphys-tab',
id = 'linegrph_introphys-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$FirstTerm_Introductory_Physics_Course_Enrollments,
aes(
x = Year,
y = `FirstTerm_Introductory_Physics_Course_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "First-Term Intro Physics Course Enrollments by Institution per Year",
x = "Year",
y = "First-Term Intro Physics Course Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
# PhySci+Astro
tags$div(
class = 'tab-pane fade',
role = 'tabpanel',
`aria-labelledby` = 'linegrph_physastro-tab',
id = 'linegrph_physastro-tabcontent',
ggplotly(
width = 0.9*1280,
height = 0.9*720,
p = ggplot(
d$FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments,
aes(
x = Year,
y = `FirstTerm_Introductory_Physical_Science_and_Astronomy_Course_Enrollments`,
group = Institution, color = Institution
)) +
geom_point(
shape = 19,
size = 0.3,
alpha = 0.7
) +
geom_spline(
df = after_stat("count"),
df.offset = 20,
tol = 0.1,
#df = list(6, 3),
na.rm = F ## only suppresses the warning on removal
) +
labs(
title = "First-Term Intro Physical Science and Astronomy Course Enrollments by Institution per Year",
x = "Year",
y = "First-Term Intro Phys. Sci. and Astro. Course Enrollments"
) +
scale_color_manual(
values = rep(
pal_jama()(7),
(length(unique(rosterdata$Institution)) / 7) + 7
)
)
) |>
style(
showlegend = F, traces = c(1:length(unique(rosterdata$Institutions)))
) |>
highlight(
opacityDim = 0.04,
selected = attrs_selected(showlegend = T)
)
),
)
)
)
)
)
)
)